home *** CD-ROM | disk | FTP | other *** search
/ Complete Internet Archive / Complete Internet Archive.iso / Page Counters / Page Counters.txt < prev    next >
Encoding:
Text File  |  1997-01-26  |  20.8 KB  |  813 lines
  1.  
  2.  
  3. #! /usr/bin/perl
  4.  
  5. # cgi-bin access counter program
  6. # Version 4.0.5
  7. #
  8. # Copyright (C) 1995 George Burgyan
  9. #
  10. # This program is free software; you can redistribute it and/or modify
  11. # it under the terms of the GNU General Public License as published by
  12. # the Free Software Foundation; either version 2 of the License, or (at
  13. # your option) any later version.
  14. # 
  15. # This program is distributed in the hope that it will be useful, but
  16. # WITHOUT ANY WARRANTY; without even the implied warranty of
  17. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  18. # General Public License for more details.
  19. #
  20. # A full copy of the GNU General Public License can be retrieved from
  21. # http://www.webtools.org/counter/copying.html
  22. #
  23. # gburgyan@webtools.org
  24. #
  25. # George Burgyan
  26. # 1380 Dill Road
  27. # South Euclid, OH 44121
  28. #
  29. # For more information look at http://www.webtools.org/counter/
  30.  
  31. ########################################################################
  32. #
  33. #   CHANGE THESE TO SUIT YOUR SITE
  34. #
  35.  
  36. # The default language option (english, french, swedish)
  37. $default_lang = "english";
  38.  
  39. # The name of the file to use.  You should probably give this an absolute path
  40. $FileName = "access_count";
  41.  
  42. # Replace with a list of regular expression IP addresses that we
  43. # are supposed to ignore.  If you don't know what this means, just use
  44. # "\." instead of periods.  Comment out entirely to ignore nothing.
  45.  
  46. #@IgnoreIP = ("199\.18\.203\..*",
  47. #          "199\.18\.159\.1",
  48. #          );
  49.  
  50. # Aliases: Set this up so that diffent pages will all yield the same
  51. # count.  For instance, if you have a link like "index.html -> home.html"
  52. # set it up like ("/index.html", "/home.html").  Make sure you give a full
  53. # path to it. This will treat "/index.html" as if it were "/home.html".
  54.  
  55. %Aliases = ("/fakename.html", "/realname.html",
  56.             "/index.html", "/home.html",
  57.         );
  58.  
  59.  
  60. # AUTOMATICALLY SET BY INSTALL!!   Modify only if necessary!!!
  61. #
  62. # BaseName: set to whatever you have counter installed as.  This is
  63. # used to derive the arguments.  No not touch the next comment.
  64.  
  65. ### AUTOMAGIC ###
  66. $BaseName = "counter";
  67.  
  68. # counter  or  counterbanner  or  counterfiglet
  69. #
  70. # Outputs the number of times a specific page has been accessed.
  71. # The output depends on which page 'called' it, and what the program
  72. # is named:
  73. #
  74. # The counter can "take arguments" via its name.  That is, if you tack
  75. # -arg to the end of the program name, -arg is taken to be an argument.
  76. # For example, if you call the counter 'counter-ord', '-ord' is considered
  77. # an argument, and an ordinal count (1st, 2nd, 3rd, ...) will be printed
  78. # instead of (1, 2, 3, ...).  Note that counterord does the same thing as
  79. # counter-ord for backward compatibility.
  80. #
  81. # Currently recognized arguments:
  82. #
  83. #  -f=font    sets "font" to be the font for figlet
  84. #  -lang=lang   sets the language used to ordinalize to "lang"
  85. #  -nc        no count; don't to write the incremented count back to the file
  86. #  -nl        no link; don't automatically generate a link
  87. #  -nd          no display; don't display anything, just count
  88. #  -ord        make an ordinal count instead of regular
  89. #  -doc=document override the DOCUMENT_URI environment variable
  90. #
  91. # Example:  counterfiglet-ord-f=bigfont-nc
  92. #
  93. # This will cause the counter to call figlet as the output routine, printing
  94. # in a big font an ordinal count, without updating the access count file.
  95. # Note that the order of arguments is irrelevant so long as you spell the
  96. # file name correctly.  It is generally assumed that the ability to take
  97. # different arguments/use different output routines is done with symlinks:
  98. # i.e. ln -s counter counterfiglet-ord-f=bigfont-nc
  99. #
  100. # More complete documentation can be found at
  101. # http://www.webtools.org/counter/
  102. #
  103. ########################################################################
  104. #
  105. # Thing that shouldn't really need changing, but are configurable anyway.
  106. #
  107.  
  108. # Maximum number of times to try to lock the file.
  109. # Each try is .1 second.  Try for 1 second.
  110. $MaxTries = 10;
  111.  
  112. # Set this to point to something, or comment it out, and it
  113. # won't be a link at all.
  114. $Link = "http://www.webtools.org/counter/";
  115.  
  116. # Whether or not to use locking.  If perl complains that flock is not
  117. # defined, change this to 0.  Not *really* necessary because we check
  118. # to make sure it works properly.
  119. $UseLocking = 1;
  120.  
  121. # What version of the counter file format are we using?
  122. $FileVersion = "02.000";
  123.  
  124. # Common names of the counter to install...
  125. @CommonExtensions = ("-ord",      # Ordinam
  126.              "figlet",      # Figlet'ed
  127.              "figlet-ord",# Ordinal figlet
  128.              "banner",    # Bannered
  129.              "banner-ord",# Ordinal banner
  130.              );
  131. #
  132. #########################################################################
  133. #
  134. # Misc documents to refer people to in case of errors.
  135. #
  136. $CreateFile = "<a href=\"http://www.webtools.org/counter/faq.html#create\">[Error Creating Counter File -- Click for more info]</a>";
  137. $AccessRights = "<a href=\"http://www.webtools.org/counter/faq.html#rights\">[Error Opening Counter File -- Click for more info]</a>";
  138. $TimeoutLock = "[Timeout locking counter file]";
  139. $BadVersion = "<a href=\"http://www.webtools.org/counter/\">[Version access_count newer than this program.  Please upgrade.]</a>";
  140.  
  141. #########################################################################
  142. #
  143. # The actual program!
  144.  
  145. ### Stage 1
  146. ###
  147. ### Parse the arguments...  (just ignore this part)
  148.  
  149. # Get arguments from program name.  Argh...what a horrible way to do it!
  150. $prog = $0;
  151. $prog =~ s/(\.cgi|\.pl)//;      #strip .cgi|.pl name extension
  152. $prog =~ s!^(.*/)!!;        # separate program name
  153. $prog =~ s/\\(.)/sprintf("%%%02x", ord($1))/ge;    # quote \c to %xx
  154.  
  155. ($printer, @args) = split(/-/, $prog);    # args are separated by dashes
  156. $printer =~ s/%(..)/pack("c", hex($1))/ge; # unquote printer function name
  157. $printer =~ s/$BaseName/counter/; # Make it cannonical.
  158.  
  159. # This gets path info, which is only applicable if you are using our
  160. # ssis script (see above).  This makes counter/ord the same as counter-ord
  161. push(@args, split("/", $ENV{"PATH_INFO"})) if $ENV{"PATH_INFO"};
  162.  
  163. # put them in assoc array %arg
  164. foreach (@args)    # means do this for each element in the array
  165. {
  166.     s/%(..)/pack("c", hex($1))/ge;    # unquote %xx
  167.     /^([^=]*)=?(.*)$/;            # extract "=" part, if any
  168.     $arg{$1} = $2 ? $2 : 1;
  169. }
  170.  
  171. if ($ARGV[0] eq '-install') {
  172.     &CheckPerl;
  173.     &SetBaseName;
  174.     &MakeCommon(0);
  175.     exit(0);
  176. }
  177.  
  178. if ($ARGV[0] eq '-installforce') {
  179.     &CheckPerl;
  180.     &SetBaseName;
  181.     &MakeCommon(1);
  182.     exit(0);
  183. }
  184.  
  185. if ($ARGV[0] eq '-unlock') {
  186.     open(FILE,"$FileName");
  187.     &UnlockFile(FILE);
  188.     exit(0);
  189. }
  190.  
  191. undef $Link if $arg{'nl'};    # make link?
  192.  
  193. ### Stage 2
  194. ###
  195. ### Print out the header
  196.  
  197. # Print out the header
  198. print "Content-type: text/html\n\n";
  199.  
  200.  
  201.  
  202. ### Stage 3
  203. ###
  204. ### Open the access_count file for read-write taking all the precautions
  205.  
  206. # Make sure the file exists:
  207. if (!(-f $FileName)) {
  208.     if (!open (COUNT,">$FileName")) {
  209.     # Can't create the file
  210.     print $CreateFile;
  211.     exit 1;
  212.     } else {
  213.     # We got the file, print out the version number
  214.     print COUNT "$FileVersion\n";
  215.     $version = 2;
  216.     }
  217. } else {
  218.     if (!((-r $FileName) && (-w $FileName))) {
  219.     # Make sure that we can in fact read and write to the file in
  220.     # question.  If not, direct them to the FAQ.
  221.     print $AccessRights;
  222.     exit 1;
  223.     }
  224.  
  225.     if (!open (COUNT,"+<$FileName")) {    # Now make sure it *really* opens
  226.     print $AccessRights;            # ...just in case...
  227.     exit 1;
  228.     }
  229.  
  230.     # Try to read in a version number
  231.     $version = <COUNT>;
  232.     if (!($version =~ /^\d+.\d+$/)) {
  233.     # No version number, assume version 1 and reset the file.
  234.     $version = 1;
  235.     seek(COUNT,0,0);
  236.     }
  237. }
  238.  
  239. # This is for the future: the access_count file will have a version number.
  240. if ($version > 2) {
  241.     print $BadVersion;
  242.     exit 1;
  243. }
  244.  
  245. ### Stage 4
  246. ###
  247. ### Attempt to lock the file
  248.  
  249.  
  250. $lockerror = &LockFile(COUNT);
  251.  
  252. # You would figure that $MaxTries would equal 0 if it didn't work.  The
  253. # post-decrement takes it to -1 when the loop finally exits.
  254. if ($lockerror) {
  255.     print $TimeoutLock;
  256.     exit(0);
  257. }
  258.  
  259.  
  260. ### Stage 5
  261. ###
  262. ### Check if we need to update the file to a newer version
  263.  
  264. if ($version < 2) {
  265.     &UpdateVersion1;
  266. }
  267.  
  268.  
  269. ### Stage 6
  270. ###
  271. ### Convert the information the server gave us into the document
  272. ### identifier.
  273.  
  274. # Make sure perl doesn't spit out warnings...
  275. if (defined $ENV{'DOCUMENT_URI'}) {
  276.     $doc_uri = $ENV{'DOCUMENT_URI'};
  277. } else {
  278.     $doc_uri = "";
  279. }
  280.  
  281. # Campatibility: Version 2 files have the server name in front if and
  282. # only if it doesn't have a "~" in it.
  283.  
  284. $old_uri = $doc_uri;
  285.  
  286. # Add the server name in front to support multi-homed hosts if and only if
  287. # it doesn't have a "~" in it.  (usernames are global in most multi-homed
  288. # settings
  289. if (defined $ENV{'SERVER_NAME'} && !($doc_uri =~ /~/)) {
  290.     $doc_uri = $ENV{'SERVER_NAME'} . "/" . $doc_uri;
  291. }
  292.  
  293. if (defined $arg{'doc'}) {
  294.     $doc_uri = $arg{'doc'};
  295. }
  296.  
  297. $doc_uri = $Aliases{$doc_uri} if defined $Aliases{$doc_uri};
  298.  
  299.  
  300. ### Stage 7
  301. ###
  302. ### Find the relevant place in the file
  303.  
  304. $location = tell COUNT;
  305. while ($line = <COUNT>) {
  306.     # Read the file line-by-line.
  307.     if (($uri,$accesses) = ($line =~ /^'(\S*)' (\d\d\d\d\d\d\d\d\d\d)$/)) {
  308.     # An old line
  309.     if ($uri eq $old_uri) {
  310.         &ConvertDocV1($doc_uri,$old_uri,$accesses,$location);
  311.         last;
  312.     }
  313.     } elsif (($uri,$accesses,$flags) = ($line =~ /^'(\S*)' (\d\d\d\d\d\d\d\d\d\d) (\w\w\w\w)$/)) {
  314.     # A new line
  315.     if ($uri eq $doc_uri) {
  316.         $flags = hex($flags);
  317.         last;
  318.     }
  319.     }
  320.  
  321.     last if ($uri eq $doc_uri);
  322.     $location = tell COUNT;
  323.     
  324.     #reset the fields
  325.     $accesses = 0;
  326.     $flags = 0;
  327. }
  328.  
  329.  
  330. ### Stage 8
  331. ###
  332. ### Update the access count of the file
  333.  
  334. $accesses += 1;    # *NOT* '++' because we don't want '++'s magic
  335.  
  336.  
  337. ### Stage 9
  338. ###
  339. ### Figure out what to print out
  340.  
  341. # If we have to ordinalize, do it now.
  342. if (defined $arg{'ord'}) {
  343.     if (defined $arg{'lang'}) {
  344.     $ord = eval("&ordinalize_$arg{lang}($accesses)");
  345.     } else {
  346.     $ord = &ordinalize($accesses);
  347.     }
  348. } else {
  349.     $ord = "";
  350. }
  351. $to_print = $accesses . $ord;
  352.  
  353. # Give it to the printer function to actually produce the output from the
  354. # ascii text that we have (to_print)
  355. ($count, $nLink) = eval("&output_$printer('$to_print')");
  356.  
  357. # If the above line gave us an error, default to just the text.
  358. if ($@) {
  359.     ($count, $nLink) = &output_counter($to_print);
  360. }
  361.  
  362. ### Stage 10
  363. ###
  364. ### Now we actually tell the browser what the count is.
  365.  
  366. if (! $arg{"nd"} ) {        # If we print anything
  367.     # Print out a link to something informative (if we were requested to)
  368.     print "<a href=\"$nLink\">" if $nLink;
  369.     print $count;
  370.     print "</a>" if $nLink;
  371. }
  372.  
  373.  
  374. ### Stage 11
  375. ###
  376. ### Check if we are supposed to update the count in the file.  (ie. we're
  377. ### not ignoring the host that just accessed us)
  378.  
  379. # Make sure we are not ignoring the host:
  380.  
  381. $ignore = 0;
  382. $ignore = grep($ENV{"REMOTE_ADDR"} =~ /$_/, @IgnoreIP) if defined ($ENV{"REMOTE_ADDR"});
  383. $ignore = $ignore || $arg{"nc"};
  384.  
  385. ### Stage 12
  386. ###
  387. ### Actually write the updated information back to the file
  388.  
  389. if (!$ignore)            # If we aren't ignoring this access
  390. {
  391.     # Now update the counter file
  392.     seek(COUNT, $location, 0);
  393.     $longaccesses = sprintf("%010.10d", $accesses);
  394.     $hexflags = sprintf("%04.4x", $flags);
  395.     print COUNT "'$doc_uri' $longaccesses $hexflags\n";
  396. }
  397.  
  398. &UnlockFile(COUNT);
  399.  
  400. close COUNT;
  401.  
  402. #######################################################################
  403. #
  404. # Support functions
  405. #
  406.  
  407. # translate_output
  408. #
  409. # Quote any special characters with HTML quoting.
  410.  
  411. sub translate_output {
  412.     local($string) = @_;
  413.  
  414.     $_ = $string;
  415.   
  416.     s/Φ/è/g;
  417.  
  418.     return $_;
  419. }
  420.  
  421. sub LockFile {
  422.     local(*FILE) = @_;
  423.     local($TrysLeft) = $MaxTries;
  424.  
  425.     if ($UseLocking) {
  426.     # Try to get a lock on the file
  427.     while ($TrysLeft--) {
  428.         
  429.         # Try to use locking, if it doesn't use locking, the eval would
  430.         # die.  Catch that, and don't use locking.
  431.  
  432.         # Try to grab the lock with a non-blocking (4) exclusive (2) lock.
  433.         # (4 | 2 = 6)
  434.         $lockresult = eval("flock(COUNT,6)");
  435.  
  436.         if ($@) {
  437.         $UseLocking = 0;
  438.         last;
  439.         }
  440.  
  441.         if (!$lockresult) {
  442.         select(undef,undef,undef,0.1); # Wait for 1/10 sec.
  443.         } else {
  444.         last;        # We have gotten the lock.
  445.         }
  446.     }
  447.     }
  448.  
  449.     if ($TrysLeft >= 0) {
  450.     # Success!
  451.     return 0;
  452.     } else {
  453.     return -1;
  454.     }
  455. }
  456.  
  457. sub UnlockFile {
  458.     local(*FILE) = @_;
  459.  
  460.     if ($UseLocking) {
  461.     flock(FILE,8);            # Unlock the file.
  462.     }
  463. }
  464.  
  465.  
  466. ####################################################################
  467. #
  468. # Installation helpers
  469. #
  470.  
  471.  
  472. # SetBaseName
  473. #
  474. # Change the counter program itself to set the basename
  475.  
  476. sub SetBaseName {
  477.     local($name) = $0;
  478.  
  479.     $name =~ s/^.*\/([^\/]+)$/$1/; # Strip off any of the path
  480.     
  481.     if ($name eq $BaseName) {    # The way we're set up now!!!
  482.     return;            # Don't need to change a thing.
  483.     }
  484.     
  485.     if (!open(COUNTERFILE, "+<$0")) {
  486.     print "Can't modify program.  Set \$BaseName manually.\n";
  487.     return;
  488.     }
  489.  
  490.     print "Configuring \$BaseName variable...\n";
  491.  
  492.     local($oldsep) = $/;
  493.     undef($/);
  494.  
  495.     local($program) = <COUNTERFILE>;
  496.     
  497.     # The next line does all the magic.
  498.     $program =~ s/\#\#\# AUTOMAGIC \#\#\#\n\$BaseName = \"[^\"]+\";\n/\#\#\# AUTOMAGIC \#\#\#\n\$BaseName = \"$name\";\n/;
  499.  
  500.     seek(COUNTERFILE,0,0) || return;
  501.     truncate(COUNTERFILE,0);
  502.     print COUNTERFILE $program;
  503.     close COUNTERFILE;
  504. }
  505.     
  506. # CheckPerl
  507. #
  508. # Make sure that the "#! /[path]/perl" points to something real...
  509.  
  510. sub CheckPerl {
  511.     if (!open(COUNTERFILE, "<$0")) {
  512.     print "Can't check to make sure Perl is in the right place.\n";
  513.     return;
  514.     }
  515.     print "Checking to make sure Perl is found properly...\n";
  516.  
  517.     $firstline = <COUNTERFILE>;
  518.     ($command) = ($firstline =~ /^\#! *([^\s]+) *$/);
  519.     close(COUNTERFILE);
  520.  
  521.     if (! -x $command) {
  522.     print "The location of Perl is misconfigured.  Please edit the\n";
  523.     print "first line of this program to point to the locally installed\n";
  524.     print "copy of perl.\n\n";
  525.     print "Currently, it is configured to be \"$command\", however,\n";
  526.     print "that file either does not exist or is not a program.\n\n";
  527.     print "Some common locations for Perl are:\n";
  528.     print "  /usr/bin/perl\n";
  529.     print "  /usr/local/bin/perl\n";
  530.     print "  /opt/gnu/bin/perl\n\n";
  531.         exit;
  532.     }
  533. }
  534.  
  535. # MakeCommon
  536. #
  537. # Make some common links to the counter
  538.  
  539. sub MakeCommon {
  540.     local($force) = @_;
  541.     local($ext);
  542.  
  543.     print "Installing the counter...\n";
  544.     print "   ...making counter executable\n";
  545.     chmod(0755,$0);
  546.  
  547.     local($path, $name, $cgi);
  548.     $name = $0;
  549.     if ($name =~ /^(.*\/)([^\/]+)$/) {
  550.     $path = $1; $name = $2;
  551.     }
  552.     if ($name =~ /^(.*)(\.cgi)$/) {
  553.     $name = $1, $cgi = $2;
  554.     }
  555.  
  556.     foreach $ext (@CommonExtensions) {
  557.     print  "   ...making link from $path$name$cgi to $path$name$ext$cgi\n";
  558.     if (!&MakeLink("$path$name$cgi","$path$name$ext$cgi",$force)) {
  559.         # An error occured while making the link.  :-(
  560.  
  561.         print "     *** An error occured while making the link.\n";
  562.     }
  563.     }
  564.     if ($symlink_exists == 0 && $link_exists == 0) {
  565.     print "* NOTE *  Your system does not support symbolic or hard links,\n";
  566.         print "          copies made instead.  If you modify the counter, you must\n";
  567.     print "          run counter -install again to recopy it to the other files.\n";
  568.     }
  569.  
  570.     print "...done!\n";
  571. }
  572.  
  573. # MakeLink
  574. #
  575. # Actually create the link.
  576.  
  577. sub MakeLink {
  578.     local($oldname,$newname,$force) = @_;
  579.  
  580.     # Check to see if we can make symbolic links instead of hard links
  581.     if (!defined $symlink_exists) {
  582.     $symlink_exists = (eval 'symlink("","");', $@ eq '');
  583.     }
  584.  
  585.     # Check to see if we can make a link if we can't make a symlink
  586.     if (!symlink_exists) {
  587.     $link_exists = (eval 'link("","");', $2 eq '');
  588.     }
  589.  
  590.     if ($force) {
  591.     # Check to see if the file exists
  592.     if (-e $newname) {
  593.         if (!unlink ($newname)) {
  594.         return 0;
  595.         }
  596.     }
  597.     }
  598.  
  599.     if ($symlink_exists) {
  600.     return symlink($oldname, $newname);
  601.     } elsif ($link_exists) {
  602.     return link($oldname, $newname);
  603.     } else {
  604.     # Copy it the old-fashioned way...  *sigh*
  605.     open(OLDFILE, $oldname) || die "Can't open $oldname for copy";
  606.     open(NEWFILE, ">$newname") || die "Can't open $newname for write";
  607.     while(<OLDFILE>) {
  608.         print NEWFILE $_;
  609.     }
  610.     close(NEWFILE);
  611.     close(OLDFILE);
  612.     }
  613. }
  614.  
  615. ####################################################################
  616. #
  617. # Ordinalizing functions
  618. #
  619.  
  620. # ordinalize
  621. #
  622. # Call the appropriate ordinalize function for the default language
  623.  
  624. sub ordinalize
  625. {
  626.     local($count) = @_;
  627.  
  628.     if (defined $arg{'lang'}) {
  629.     return eval("&ordinalize_$arg{lang}($count)");
  630.     } else {
  631.     return eval("&ordinalize_$default_lang($count)");
  632.     }
  633. }
  634.  
  635.  
  636. # ordinalize_english
  637. #
  638. # Figure out what suffix (st, nd, rd, th) a number would have in ordinal
  639. # form and return that extension.
  640.  
  641. sub ordinalize_english {
  642.     local($count) = @_;
  643.     local($last, $last2);
  644.  
  645.     $last2 = $count % 100;
  646.     $last = $count % 10;
  647.  
  648.     if ($last2 < 10 || $last2 > 13) {
  649.     return "st" if $last == 1;
  650.     return "nd" if $last == 2;
  651.     return "rd" if $last == 3;
  652.     }
  653.  
  654.     return "th";        # Catch "eleventh, twelveth, thirteenth" etc.
  655. }
  656.  
  657. # ordinalize_french
  658. #
  659. # Trivial...  Return the extension for french.  The only exception is 1.
  660. # Thank you Chris Polewczuk <chris@hexonx.com>
  661.  
  662. sub ordinalize_french {
  663.     local ($count) = @_;
  664.  
  665.     if ($count == 1) {
  666.     return "'iΦre";
  667.     } else {
  668.     return "iΦme";
  669.     }
  670. }
  671.  
  672. # ordinalize_swedish
  673. #
  674. # A function to ordinalize in Swedish.  Thanks go to Johan Linde
  675. # <jl@theophys.kth.se> for the code!
  676.  
  677. sub ordinalize_swedish {
  678.     local($count) = @_;
  679.     local($last, $last2);
  680.  
  681.     $last2 = $count % 100;
  682.     $last = $count % 10;
  683.  
  684.     if ($last2 < 10 || $last2 > 12) {
  685.         return ":a" if ($last == 1 || $last == 2);
  686.     }
  687.  
  688.     return ":e";
  689. }
  690.  
  691.  
  692. ########################################################################
  693. #
  694. # Output functions
  695. #
  696. # The following are the routines that actually convert the number
  697. # of accesses into something that we print out.
  698. #
  699. # The name of each function is "output_" followed by the program's name.
  700. # For instance, is the program is called "counter" then "output_counter"
  701. # will be called; a program called "counterbanner" will call
  702. # "output_counterbanner" to get the output.
  703. #
  704. # If the function is not defined, then "output_counter" will be called.
  705. #
  706.  
  707. # output_counter
  708. #
  709. # The simplest function: just returns the number of accesses and the link.
  710.  
  711. sub output_counter {
  712.     local($count) = @_;
  713.  
  714.     return &translate_output($count), $Link; # we return the count and the link
  715. }
  716.  
  717.  
  718. # output_counterord
  719. #
  720. # Return the number of accesses as an ordinal number.  (ie. 1st, 2nd, 3rd, 4th)
  721.  
  722. sub output_counterord {
  723.     local($count) = @_;
  724.  
  725.     return &translate_output($count . &ordinalize($count)), $Link;
  726. }
  727.  
  728.  
  729. # output_counterbanner
  730. #
  731. # A somewhat silly one that uses the "banner" command to print out the
  732. # count.  :)  You might need to change the path to make it work.
  733.  
  734. sub output_counterbanner {
  735.     local($count) = @_;
  736.     
  737.     $banner = `banner $count`;
  738.  
  739.     return "<pre>$banner</pre>"; # return no link here (it would be annoying)
  740. }
  741.  
  742.  
  743. # output_counterfiglet
  744. #
  745. # An even sillier one than counterbanner.  :)
  746.  
  747. sub output_counterfiglet {
  748.     local($count) = @_;
  749.  
  750.     $fig = "echo $count | /usr/games/figlet";    # setup command line
  751.     $fig .= " -f $arg{'f'}" if $arg{"f"};    # use a different font?
  752.     $fig = `$fig`;
  753.     $fig =~ s!&!&!;
  754.     $fig =~ s!<!<!;
  755.     return "<br><pre>" . $fig . "</pre>";    # note no link here, either
  756. }
  757.  
  758.  
  759.  
  760. #########################################################################
  761. #
  762. # Conversion functions
  763. #
  764.  
  765. # UpdateVersion
  766. #
  767. # Convert a version 1file into a version 2 file.
  768.  
  769. sub UpdateVersion1 {
  770.     local ($contents,$dummy);
  771.     local ($oldsep) = $/;
  772.  
  773.     $/ = "";
  774.     seek(COUNT,0,0);        # Go to the beginning of the file
  775.     $contents = <COUNT>;
  776.     seek(COUNT,0,0);
  777.     print COUNT "$FileVersion\n";
  778.     print COUNT $contents;
  779.     seek(COUNT,0,0);
  780.     $/ = $oldsep;
  781.     $dummy = <COUNT>;        # Skip the new line
  782. }
  783.  
  784.  
  785. # ConvertDocV1
  786. #
  787. # Convert the a version 1 line into a version 2 line
  788.  
  789. sub ConvertDocV1 {
  790.     local ($doc_uri,$old_uri,$accesses,$location) = @_;
  791.     local ($contents,$dummy,$oldsep);
  792.  
  793.     $oldsep = $/;
  794.  
  795.     seek (COUNT,$location,0);    # Skip the line in question
  796.     $dummy = <COUNT>;
  797.     
  798.     $/ = "";            # Read in the whole file
  799.     $contents = <COUNT>;
  800.  
  801.     seek (COUNT,$location,0);
  802.     
  803.     local ($longaccesses,$hexflags);
  804.     $longaccesses = sprintf("%010.10d", $accesses);
  805.     $hexflags = sprintf("%04.4x", $flags);
  806.  
  807.     # Print out the new stuff
  808.     print COUNT "'$doc_uri' $longaccesses $hexflags\n";
  809.     print COUNT $contents;
  810.  
  811.     $/ = $oldsep;
  812. }
  813.